perm filename READER.92[MAC,LSP] blob
sn#251576 filedate 1976-12-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00042 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002
C00007 00003
C00010 00004
C00012 00005
C00013 00006
C00015 00007
C00019 00008
C00021 00009
C00023 00010
C00025 00011
C00033 00012
C00035 00013
C00037 00014
C00040 00015
C00042 00016
C00045 00017
C00047 00018
C00050 00019
C00052 00020
C00054 00021
C00055 00022
C00057 00023
C00059 00024
C00061 00025
C00063 00026
C00065 00027
C00067 00028
C00069 00029
C00071 00030
C00073 00031
C00074 00032
C00077 00033
C00080 00034
C00082 00035
C00084 00036
C00086 00037
C00089 00038
C00098 00039
C00102 00040
C00105 00041
C00107 00042
C00110 ENDMK
C⊗;
;;; **************************************************************
;;; ***** MACLISP ****** READ AND RELATED FUNCTIONS **************
;;; **************************************************************
;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
PGBOT [RDR]
SUBTTL HIRSUTE READER AND INPUT PACKAGE
IFN NEWRD,[
;;;DEFINE READER-SYNTAX BITS
;;;THESE BITS OCCUPY 2.1-3.8. DO NOT USE 3.9 (SEE TYIPEEK)
RS.FF==004000,, ;FORCE-FEED CHARACTER
RS.VMO==002000,, ;VERTICAL MOTION (LF, FF)
RS.SQX==001000,, ;EXPONENT MARKER, STRING QUOTE
RS.BRK==000400,, ;SPECIAL ACTION NEEDED ON INPUT
RS.SCO==000200,, ;SINGLE-CHARACTER OBJECT
RS.WSP==000100,, ;WHITE SPACE - SPACE, TAB, COMMA
RS.LP ==000040,, ;LEFT PARENTHESIS
RS.DOT==000020,, ;DOTTED-PAIR DOT
RS.RP ==000010,, ;RIGHT PARENTHESIS
RS.MAC==000004,, ;MACRO-CHARACTER (RS.ALT = SPLICING)
RS.SLS==000002,, ;SLASHIFIER
RS.RBO==000001,, ;RUBOUT, FORCEFEED
RS.SL1==400000 ;SLASH IF FIRST IN PNAME
RS.PNT==200000 ;DECIMAL POINT (FOR NUMBERS)
RS.SL9==100000 ;SLASH IF NOT FIRST IN PNAME
RS.ALT==040000 ;CHANGE MEANING OF OTHER BITS
RS.ARR==020000 ;NUMBER MODIFIERS ← AND ↑
RS.SGN==010000 ;NUMBERS SIGNS + AND -
RS.DIG==004000 ;DIGITS 0 THROUGH 9
RS.XLT==002000 ;EXTENDED LETTERS (LIKE :)
RS.LTR==001000 ;REGULAR LETTERS (LIKE X)
IRP A,,[FF,VMO,SQX,BRK,SCO,WSP,LP,DOT,RP,MAC,SLS,RBO]
RS%!A==<RS.!A>←22
TERMIN
NWTNE==:TRNE
NWTNN==:TRNN
DEFINE NWTN ZP,AC,SX
TDN!ZP AC,[RS.!SX]
TERMIN
] ;END IFN NEWRD
IFE NEWRD,[
;;;DEFINE READER-STYNTAX BITS
RS.FF==0
RS.VMO==0
RS.SQX==0
RS.BRK==400000
RS.SCO==200000
RS.WSP==100000
RS.LP==40000
RS.DOT==20000
RS.RP==10000
RS.MAC==4000
RS.SLS==2000
RS.RBO==1000
RS.SL1==400
RS.PNT==200
RS.SL9==100
RS.ALT==40
RS.ARR==20
RS.SGN==10
RS.DIG==4
RS.XLT==2
RS.LTR==1
IRP A,,[FF,VMO,SQX,BRK,SCO,WSP,LP,DOT,RP,MAC,SLS,RBO]
RS%!A==RS.!A
TERMIN
NWTNE==:TLNE
NWTNN==:TLNN
DEFINE NWTN ZP,AC,SX
TLN!ZP AC,RS.!SX
TERMIN
] ;END OF IFE NEWRD
RS.CMS==RS.<BRK+SL1+SL9+MAC> ;CHARACTER-MACRO SYNTAX
RS.SCS==RS.<BRK+SL1+SL9+SCO> ;SINGLE-CHAR-OBJ SYNTAX
RS.OBB==RS.<SQX+SCO+LP+MAC+SLS+PNT+SGN+DIG+XLT+LTR> ;SYNTAX FOR CHARS THAT BEGIN OBJECTS
RS.WTH==RS.<OBB+DOT+RP+ARR> ;PRETTY MUCH, ANY WORTHY CHAR
RS.SEE==RS.<WTH+WSP+RBO+FF> ;ALMOST ANY CHAR THAT YOU REALLY SEE
SUBTTL READCH AND ASCII FUNCTIONS, OLD I/O TYI FUNCTION
$READCH:
Q% JSP R,ORD
Q$ JSP D,INCALL
Q$READCH
READCH: PUSHJ P,TYI
RDCH3: MOVE TT,A
JRST RDCH2
$ASCII: JSP T,FXNV1
RDCH2: ANDI TT,177
MOVE B,TT
MOVE D,VOBARRAY
ADDI TT,OBTSIZ+1
ROT TT,-1
JUMPL TT,.+3
HLRZ A,@1(D)
JRST .+2
HRRZ A,@1(D)
JUMPN A,CPOPJ
JRST RDCHO
IFE QIO,[
%TYI:
$TYI: SKIPA R,[400000,,MAKNUM]
CA2TT: MOVEI R,A2TT
JUMPN T,$TYI1
PUSH P,R
CTYI: JRST TYI
A2TT: MOVEI TT,(A) ;WHEN TYI PRODUCES AN ANSWER IN A
CAILE TT,300. ;AND WE WANT THE ANSWER IN TT, WE JUST
MOVE TT,(TT) ;MOVE IT THERE, AND CHECK FOR THE CASE OF
POPJ P, ;E-O-F CAUSING INPUT ARG TO BE IN A
$TYI1A: %WTA FXNMER
JRST $TYI1B
$TYI1: MOVEI D,Q%TYI
CAME T,XC-1
JRST WNALOSE
POP P,A
$TYI1B: SKOTT A,FX
JRST $TYI1A
JUMPGE R,.+2
PUSH P,CFIX1
PUSH P,CA2TT
PUSH P,A
JSP R,ORD
Q%TYI
TYI: SKIPE A,TYIMAN
JRST (A)
SKIPN TAPRED ;NOTE HOW THIS MUST SAVE D - SEE $TYI
JRST TYI1
PUSHJ P,URED
SKIPA A,CTYI ;CONTAINS "TYI"
POPJ P,
.UEOF: PUSH P,A
10% .CLOSE UTIC,
10$ CLOSE UTIC,
10$ RELEASE UTIC,
MOVE A,[0700,,UTIB-1]
MOVEM A,UTIBP
MOVSI A,<↑C>←13
HLLM A,UTIB
SETZB A,UTIOPD
SETOM AFILRD
SETZM TAPRED
SKIPN EOFRTN
C15: POPJ P,15
RDTRB3: MOVE P,EOFRTN
JRST ERR1
;;; IFE QIO
TYI1: SKIPN B,RDTYBF
JRST TYIN
PUSHJ P,RDIN2
TYI2: CAIGE A,200
POPJ P,
CAIN A,203
JRST TYI1
CAILE A,TLRCT-1
LER3 [SIXBIT \RANDOM CHAR - TYI!\]
HRRZ A,RCT0(A) ;CAUSE PROPER TRANSLATION OF THE "SUPRA-ASCII" PSEUDO CHARS
POPJ P,
TYIN: MOVEI A,0
EXCH A,PBFTY
JUMPN A,TYI2
SETZM TAPRED
TTYTYI:
IFN ITS,[
SPECPRO INTTYI
.IOT TYIC,A
NOPRO
CAIN A,↑U ;FLUSH ↑U FROM TTY INPUT SINCE IT IS
JRST TTYTYI ;FOR RELEASING THE PAGEPAUSE
POPJ P,
] ;END OF IFN ITS
IFN D10,[
SKIPN LINMODE
JRST TTYTY1
SPECPRO INTTYI
INCHWL A
NOPRO
JRST TTYTY2
SPECPRO INTTYI
TTYTY1: INCHRW A
NOPRO
TTYTY2:
IFN SAIL,[
TRNE A,400 ;META?
POPJ P, ;YES
TRNN A,200 ;CONTROL?
POPJ P, ;NO
CAIGE A,300 ;IS IT A LETTER TYPE CONTROL CHAR?
POPJ P, ;NO
PUSH P,A
TRZ A,300
JSR CNTROL
JRST POPAJ
] ;END IFN SAIL
.ELSE,[
CAILE A,↑↑
POPJ P,
PUSH P,A
JSR CNTROL
JRST POPAJ
] ;END IFE SAIL
] ;END OF IFN D10
;; This is the pre-processor for converting from the SAIL ASCII
;; character set to DEC style.
IFN SAIL,[
SAILPP: CAIN A,32 ;A TILDE?
JRST SAIPP1
CAIN A,176 ;A }
JRST SAIPP2
CAIE A,175 ;AN ALTMODE
JRST SAIPP3
MOVEI A,33
JRST SAIPP3
SAIPP1: MOVEI A,176
JRST SAIPP3
SAIPP2: MOVEI A,175
SAIPP3: TRZE A,600 ;CTRL/META/BOTH?
TRZ A,100 ;MAKE DEC STYLE
POPJ P,
] ;END OF IFN SAIL
;;; IFE QIO
URED: SKIPN UTIOPD
JRST UREDER
10$ SOSGE UTIBYT
10$ JRST UREDBF
ILDB A,UTIBP
10$ JUMPE A,URED
CAIE A,↑C
JRST POPJ1
MOVEI A,UTIB+UTBSIZ
CAIE A,@UTIBP
POPJ P,
UREDBF:
IFN ITS,[
MOVE A,[-UTBSIZ,,UTIB]
.IOT UTIC,A
CAMN A,[-UTBSIZ,,UTIB]
POPJ P,
HRLI A,<↑C>←13 ;IN CASE WE READ IN A MULTIPLE OF 5
HLLZM A,(A) ; CHARS: WE MIGHT NOT HAVE GOTTEN A ↑C
MOVE A,[440700,,UTIB]
MOVEM A,UTIBP
JRST URED
] ;END OF IFN ITS
IFN D10,[
IN UTIC,
JRST URED
STATZ UTIC,20000 ;CHECK FOR EOF
POPJ P,
JRST URED
] ;END OF IFN D10
ORD: JUMPE T,1(R) ;SET-UP RETURN FOR READ WITH ARG
AOSE T ;MUST SAVE TT - SEE $TYI
JRST ORD7
SKIPE EOFRTN
JRST ORD3
PUSH P,[ORD1]
JSP T,ERSTP
MOVEM P,EOFRTN
PUSHJ P,1(R)
SUB P,[LERSTP+2,,LERSTP+2] ;REMOVE [ARG], [ORD1], AND ERSTP
ORD2: SETZM EOFRTN
POPJ P,
ORD1: POP P,A
JRST ORD2
ORD3: SUB P,R70+1
JRST 1(R)
ORD7: MOVE D,(R)
SOJA T,WNALOSE
] ;END OF IFE QIO
IFN QIO,[
SUBTTL NEWIO INPUT FUNCTION ARGS PROCESSOR
;;; JSP D,INCALL
;;; Q<FNNAME>
;;; PROCESSES ARGUMENTS FOR AN INPUT FUNCTION TAKING STANDARD
;;; ARGUMENTS (EOF VALUE AND/OR FILE ARRAY). SAVES F.
;;; JSP D,XINCALL
;;; Q<FNNAME>
;;; IS SIMILAR, BUT INSISTS ON A FIXNUM RESULT (FOR TYI, TYIPEEK),
;;; AND EXPECTS F TO CONTAIN EITHER "FIX1" OR "CPOPJ".
;;; SAVES AR2A (SEE TYIPEEK).
XINCALL: JUMPN T,XINCA1
PUSH P,F
JRST 1(D)
XINCA1: TLOA D,1 ;MUST HAVE FIXNUM RESULT
INCALL: JUMPE T,1(D) ;ZERO ARGS - TRIVIAL
AOJL T,INCAL2
POP P,AR1 ;ONE ARG - IS IT A FILE?
JUMPE AR1,EOFBN0 ;NOT IF NIL
JSP TT,XFILEP
JRST EOFBN0 ;NOT IF T, OR IF NOT FILE
INCAL1: SETZ A, ;DEFAULT EOF VALUE IS NIL
INBIND: SKIPE B,AR1
JRST INBN4
PUSHJ P,INFGET ;GETS VINFILE IN AR1
MOVEI B,(AR1)
INBN4: CAIN B,TRUTH
TDZA C,C
SKIPA C,[TRUTH]
HRRZ AR1,V%TYI
; PUSHJ P,ATIFOK
; UNLOCKI
MOVSI T,-LINBN9 ;OPEN-CODING OF SPECBIND
MOVEM SP,SPSV
INBN1: HRRZ TT,INBN9(T)
HRRZ R,(TT)
HRLI R,(TT)
PUSH SP,R
HLRZ R,INBN9(T)
TRNN R,777760
HRRZ R,(R)
MOVEM R,(TT)
AOBJN T,INBN1
JSP T,SPECX ;END OF SPECBIND
PUSH P,CUNBIND
JRST EOFBIND
INBN9: C,,TAPRED ;TABLE OF VALUE CELLS FOR INBIND
B,,VINFILE ; EACH ENTRY IS OF FORM:
NIL,,VINSTACK ; <NEW VALUE>,,<VALUE CELL>
$DEVICE,,TYIMAN ; IF NEW VALUE IS AN AC, THEN
UNTYI,,UNTYIMAN ; THE AC CONTAINS THE REAL
;; UNRD,,UNREADMAN ; NEW VALUE.
;; READP,,READPMAN
LINBN9==.-INBN9
INCAL2: AOJL T,INCAL7
POP P,A ;TWO ARGS
POP P,AR1
JUMPE AR1,INBIND
CAIN AR1,TRUTH
JRST INBIND
JSP TT,XFILEP
EXCH A,AR1
JRST INBIND
INCAL7: HRRZ D,(D) ;MORE THAN TWO ARGS: FOOEY.
JRST S2WNAL
EOFBN0: MOVEI A,(AR1)
EOFBIND: TLNN D,1 ;BIND FOR INPUT EOF TRAP
JRST EOFBN3
PUSH P,F ;FOR NUMERICAL INPUT FN, FIX1 OR CPOPJ
TLO A,400000
EOFBN3: PUSH P,A
PUSH P,CEOFBN5
JSP T,ERSTP ;SET UP A FRAME
MOVEM P,EOFRTN ;THIS IS AN EOF FRAME
SETZM BFPRDP .SEE EOF2
PUSHJ P,1(D) ;RUN CALLING FUNCTION
MOVSI D,-LEP1+1(P) ;RESTORE FRAME STUFF
HRRI D,ERRTN
BLT D,ERRTN+LEP1-1
SUB P,[LERSTP+2,,LERSTP+2] ;FLUSH FRAME
POPJ P, ;RETURN (RESULT IN A OR TT)
EOFBN5: POP P,A ;COME HERE ON EOF
TLZN A,400000
CEOFBN5: POPJ P,EOFBN5
SKIPN A ;FOR A NULL EOF VALUE, SNEAKILY
SKIPA TT,XC-1 ; SLIP IN A -1 INSTEAD
JSP T,FXNV1 ;ELSE WHAT WAS PROVIDED
POPJ P, ; MUST BE A FIXNUM
;;; IFN QIO
SUBTTL NEWIO END-OF-FILE HANDLING
;;; HANDLE EOF ON STANDARD FILE ARRAY IN AR1.
EOF: PUSHJ FXP,SAV5
HRRZ T,BFPRDP ;CHECK WHETHER IN READ
JUMPN T,EOFE
EOF2: MOVEI TT,FI.EOF
HRRZ B,@TTSAR(AR1)
JUMPE B,EOF5
EXCH B,AR1
SKIPE A,EOFRTN
HRRZ A,-LERSTP-1(A) .SEE EOFBIND
EXCH A,B
CALLF 2,(AR1)
JUMPN A,EOF4
EOF8: PUSHJ P,INPOP
PUSHJ P,EOF7
EOF1: JSP R,PDLA2-5
POPJ P,
EOF7: HRRZ A,-2(P) ;SAVED AR1
MOVE TT,TTSAR(A)
TLNN TT,TTS<TY> ;DON'T CLOSE TTY INPUT,
PUSHJ P,ICLOSE ; FOR THAT WAS MERELY OVER-RUBOUT
POPJ P,
EOF4: CAIN A,TRUTH
JRST EOF1
SKIPN T,EOFRTN
JRST EOF8
HRRM A,-LERSTP-1(T) .SEE EOFBIND
EOF9: MOVE P,EOFRTN .SEE TYPK9
JRST ERR1
EOF5: PUSHJ P,EOF7
PUSHJ P,INPOP ;NO EOF FUNCTION
SKIPN EOFRTN
JRST EOF1
JRST EOF9
;;; IFN QIO
SUBTTL NEWIO INPUSH FUNCTION
;;; HAIRY INPUSH FUNCTION. PUSHES FILE ONTO INSTACK,
;;; OR MAYBE PUSHES INFILE, OR MAYBE POPS.
;;; INPOP POPS INSTACK INTO INFILE ONCE.
INPU0: WTA [BAD ARG - INPUSH!]
INPUSH: CAIN A,TRUTH ;SUBR 1
HRRZ A,V%TYI
JSP TT,AFILEP
JRST INPU2
PUSHJ P,ATIFOK
UNLOCKI
EXCH A,VINFILE
HRRZ B,VINSTACK
PUSHJ P,CONS
MOVEM B,VINSTACK
INPU1: SKIPN A,VINFILE
JRST INPU12
CAIN A,TRUTH
SETZM TAPRED
POPJ P,
INPU12: PUSHJ P,INFLUZ
JRST INPU1
INPU2: SKOTT A,FX
JRST INPU0
SKIPN TT,(A)
JRST INPU1
JUMPL TT,INPU5
INPU3: HRRZ A,VINFILE ;AN INPUSH LOOP
HRRZ B,VINSTACK
PUSHJ P,CONS
MOVEM A,VINSTACK
SOJG TT,INPU3
JRST INPU1
INPOP: MOVNI TT,1
PUSH P,A ;MUST SAVE A (E.G., SEE LOAD)
PUSH P,CPOPAJ
INPU5: PUSH FXP,TT
INPU6: SKIPN A,VINSTACK
JRST INPU8
HLRZ AR1,(A)
; PUSHJ P,ATIFOK
; UNLOCKI
HLRZ AR1,(A)
MOVEM AR1,VINFILE
HRRZ A,(A)
MOVEM A,VINSTACK
AOSGE (FXP)
JRST INPU6
INPU7: SUB FXP,R70+1
JRST INPU1
INPU8: MOVEI A,TRUTH
MOVEM A,VINFILE
JRST INPU7
;;; IFN QIO
SUBTTL NEWIO TYI FUNCTION AND RELATED ROUTINES
%TYI: SKIPA F,CFIX1 ;LSUBR (0 . 2) NCALLABLE
MOVEI F,CPOPJ
JSP D,XINCALL
Q%TYI
MOVEI A,Q%TYI
HRLZM A,BFPRDP
PUSHJ P,@TYIMAN
SETZM BFPRDP
POPJ P,
TYI: PUSHJ P,@TYIMAN
MOVEI A,(TT) ;CRAP
POPJ P,
;;; MAIN UNTYI ROUTINE
;;; ACCEPTS CHARACTER IN A AND INPUT FILE IN VINFILE.
;;; STICKS CHARACTER BACK INTO CHARACTER BUFFER.
;;; CLOBBERS A,B,AR1,T,TT,D. MUST SAVE C (SEE READ).
UNTYI: PUSHJ P,INFGET ;GETS VINFILE IN AR1
SKIPE TAPRED
CAIN AR1,TRUTH
HRRZ AR1,V%TYI
MOVEI D,200000(A) ;USE 200000 BIT (IN CASE OF ↑@)
MOVEI TT,FI.BBC
HLRZ T,@TTSAR(AR1) ;GET SINGLE BUFFERED CHAR
JUMPE T,UNTYI3 ;THERE IS NONE - THIS IS EASY
HRRZ B,@TTSAR(AR1) ;FOOEY - WE MUST CONS THE
MOVEI TT,-200000(T) ; OLD BUFFERED BACK CHAR
JSP T,FXCONS ; INTO THE LIST TO LEAVE ROOM
PUSHJ P,CONS ; FOR THE NEW ONE
MOVEI TT,FI.BBC
HRRZM A,@TTSAR(AR1)
UNTYI3: HRLM D,@TTSAR(AR1) ;BUFFER BACK NEW CHAR
POPJ P,
;;; MAIN INPUT FILE ARRAY HANDLER
;;; FILE ARRAY IN VINFILE.
;;; SAVES A,B,C,AR2A; CLOBBERS AR1.
;;; RETURNS CHARACTER IN TT.
;;; ACCUMULATOR D IS ZERO FOR PEEKING, ELSE 1.
$PEEK: TDZA D,D
$DEVICE: MOVEI D,1
$DEV0: PUSHJ P,INFGET ;GETS VINFILE IN AR1
SKIPE TAPRED
CAIN AR1,TRUTH
HRRZ AR1,V%TYI
MOVSI T,TTS.CL
TDNE T,TTSAR(AR1)
JRST $DVLUZ ;INPUT (FILE) CLOSED LOSSAGE!
.5LOCKI
MOVE T,TTSAR(AR1)
SKIPE FI.BBF(T)
JRST $DEVER
SKIPN TT,FI.BBC(T)
JRST $DEV2
TLZN TT,200000
JRST $DEV1
HLRZ TT,TT
SKIPE D
HRRZS FI.BBC(T)
JRST $DEV7
$DEV1: MOVS TT,(TT)
SKIPE D
HLRZM TT,FI.BBC(T)
MOVE TT,(TT)
JRST $DEV7
$DVLUZ: PUSHJ P,INFLZZ
JRST $DEV0
$DEV2: HLRZ R,BFPRDP
TLNN T,TTS<TY> ;IF THIS ISN'T A TTY,
JRST $DEV4 ; THEN FORGET CLEVER HACKS
CAIN R,Q%TYI ;IF THIS IS TYI, THEN
JRST $DEV4H ; PULL CLEVER ACTIVATION HACK
JUMPE R,$DEV4 ;NIL MEANS NO CLEVERNESS AT ALL
HRRZ R,TI.BFN(T) ;FORGET PRE-SCAN IF THERE IS
JUMPE R,$DEV4Q ; NO PRE-SCAN FUNCTION
$DEV2B: HRLM D,(P)
PUSHJ FXP,SAV5 ;OTHERWISE SAVE THE WORLD
MOVEI A,(AR1) ;INVOKE THE PRE-SCAN FUNCTION
HLRZ B,BFPRDP ; WITH THREE ARGUMENTS:
MOVEI AR2A,(R) ; (1) THE FILE ARRAY
UNLOCKI ; (2) THE FUNCTION TO BUFFER FOR
LDB T,[002100,,BFPRDP] ; (3) IF (2) IS 'READ, THE
PUSH FXP,T ; NUMBER OF HANGING OPEN
MOVEI C,(FXP) ; PARENTHESES
CALLF 3,(AR2A)
SUB FXP,R70+1
HRRZ AR1,-1(P)
JUMPN A,$DEV2D ;NIL MEANS OVER-RUBOUT, ERGO EOF
JSP R,PDLA2-5
JRST $DEV4D
$DEV2D: MOVEI C,(A)
SKIPE V.RSET
CAIN R,QTTYBUF ;DON'T NEED TO CHECK RESULT IF
JRST $DEV2P ; IT WAS OUR OLD FRIEND TTYBUF
MOVEI B,(C)
$DEV2E: JUMPE B,$DEV2P
HLRZ A,(B)
JSP F,TYOARG
HRRZ B,(B)
JRST $DEV2E
$DEV2P: HRRZ AR1,-1(P)
MOVEI TT,FI.BBC
HRRZM C,@TTSAR(AR1)
JSP R,PDLA2-5
HLRZ D,(P)
JRST $DEV0
$DEV4Q: MOVE F,F.MODE(T)
TLNN F,FBT<FU> ;IF TTY DOESN'T HAVE 12.-BIT
JRST $DEV4 ; CHARS, THEN WE ARE WINNING
UNLOCKI
PUSHJ P,INFLUZ ;OTHERWISE WE LOSE
JRST $DEV0
$DEV4: SKIPL F,F.MODE(T) .SEE FBT.CM
JRST $DEV5
HRLM D,(P)
PUSHJ P,TYIF1
HLRZ D,(P)
$DEV4B: JUMPGE TT,$DEV6
$DEV4A: UNLOCKI
$DEV4D: MOVNI TT,1
JUMPE D,CPOPJ ;ONLY PEEKING, SO MERELY RETURN -1
PUSHJ P,EOF ;SIGNAL EOF
JRST $DEVICE ;RETRY IF WE SURVIVE
$DEV4H: SKIPL F,F.MODE(T)
JRST $DEV5 ;BUFFERED TTY INPUT??? OH WELL.
SPECPRO INTTYY
$DEV4J: .CALL $DEV4M ;GOBBLE CHAR, EVEN IF NOT ACTIVATED
NOPRO
.VALUE
MOVE TT,TTSAR(AR1)
SKIPN FT.CNS(TT)
JRST $DEV4K ;DONE IF NO ASSOCIATED OUTPUT TTY
HRLM D,(P)
PUSH P,AR1
HRRZ AR1,FT.CNS(TT)
PUSHJ P,TTYBR1 ;OTHERWISE READ IN NEW CURSORPOS OF TTY
MOVE TT,TTSAR(AR1)
POP P,AR1
HLRZM D,AT.LNN(TT) ;UPDATE CHARPOS AND LINENUM
HRRZM D,AT.CHS(TT)
HLRZ D,(P)
MOVE TT,TTSAR(AR1)
$DEV4K: EXCH T,TT
JRST $DEV4B
INTTYS: HRROS INHIBIT ;PROTECTION ROUTINE FOR $DEV4J
MOVE T,TTSAR(AR1)
JRST $DEV4J
$DEV4M: SETZ
SIXBIT \IOT\ ;I/O TRANSFER
5000,,%TI<ACT> ;READ CHAR EVEN IF NOT ACTIVATOR
,,F.CHAN(T) ;CHANNEL #
402000,,T ;SINGLE CHAR RETURNED HERE
$DEV5F: PUSHJ P,$DEV5K
JRST $DEV4A
$DEV5: SOSGE AB.CNT(T) ;GOBBLE NEXT INPUT CHAR
JRST $DEV5F ;MAY NEED TO GET NEW BUFFER
ILDB TT,AB.BP(T)
$DEV6: JUMPN D,$DEV6B
MOVEI D,(TT)
ANDI D,177+%TXCTL
TRZN D,%TXCTL
JRST .+3
CAIE D,177
TRZ D,140
TRO D,200000
HRLM D,FI.BBC(T)
SETZ D,
$DEV6B: CAIN TT,↑J
AOS AT.LNN(T)
CAIE TT,↑L
JRST $DEV7
SETZM AT.LNN(T)
AOS AT.PGN(T)
$DEV7: SKIPE AR1,VECHOFILES ;SKIP UNLESS ECHO FILES
SKIPN D ;DON'T ECHO PEEKED-AT CHARS
UNLKPOPJ
HRLI AR1,200000 ;LIST OF FILES, NO TTY
HRLM TT,AR2A
PUSH P,AR2A
JSP T,GTRDTB ;GET READTABLE
LDB TT,[220700,,(P)] ;WATCHIT! CHAR COULD BE 12. BITS
PUSHJ P,TYO6 ;PUSH CHAR INTO ALL ECHO FILES
HLRZ TT,(P)
POP P,AR2A
UNLKPOPJ
$DEV5K: MOVE TT,FB.IOT(T) ;ROUTINE TO REFILL INPUT BUFFER
EXCH T,TT
.CALL IOTTTT
.VALUE
EXCH T,TT
CAMN TT,FB.IOT(T)
POPJ P, ;END OF FILE
SUB TT,FB.IOT(T)
TLZ TT,-1
IMULI TT,@FB.BYT(T)
MOVEM TT,AB.CNT(T)
MOVE TT,FB.BFL(T)
SKIPL F.FPOS(T)
ADDM TT,F.FPOS(T)
MOVEI TT,FB.BUF-1(T)
HLL TT,FB.BYT(T)
MOVEM TT,AB.BP(T)
JRST POPJ1
$DEVER: UNLOCKI
SETO TT,
JUMPE D,CPOPJ
PUSH P,CPOPNVJ
MOVEI A,(AR1)
PUSHJ P,NCONS
MOVEI B,Q%TYI
PUSHJ P,XCONS
IOL [CAN'T TYI - FORM(S) PENDING!]
INFGT0: PUSHJ P,INFLUZ
INFGET: SKIPN AR1,VINFILE ;GET VINFILE IN AR1
JRST INFGT0
POPJ P,
INFLZZ: SKIPA T,[[SIXBIT \INFILE CLOSED!\]]
INFLUZ: MOVEI T,[SIXBIT \BAD VALUE FOR INFILE!\]
PUSH P,A
MOVEI A,TRUTH ;INFILE IS A LOSER!
EXCH A,VINFILE
PUSH P,CPOPAJ
%FAC (T)
] ;END OF IFN QIO
SUBTTL READLIST, IMPLODE, MAKNAM
Q% BYTEAC==A
Q$ BYTEAC==TT
MKNR6C: MOVEM T,MKNCH
JSP TT,IRDA
SKIPA
MKR6DB: IDPB BYTEAC,C
PUSHJ P,@MKNCH
Q% JUMPE A,RDAEND
Q$ JRST RDAEND
SOJGE D,MKR6DB
PUSH FXP,BYTEAC
PUSHJ FXP,RDA4
JSP TT,IRDA1
POP FXP,BYTEAC
SOJA D,MKR6DB
IFE QIO,[
READLIST: MOVEI B,MKNAM2 ;SUBR 1
JUMPE A,RDL12 ;MKNAM2 IS JUST THE THING:
JSP T,SPECBIND ;LIKE KRYPTONITE, IT GLOWS COLD GREEN;
Q% 0 B,TYIMAN ;FORCE TYIMAN TO DO OUR WILL,
Q% 0 NIL,TMBBC ;SO READ FROM READLIST GETS ITS FILL!
0 A,MKNM3
MOVEI A,(B)
PUSHJ P,READ0A
SKIPE T,MKNM3
CAIN T,-1
JRST UNBIND
LERR EMS1 ;EXTRA CHARS IN LIST
READ6C: MOVEM A,CORBP ;SAVES F - SEE FSLSTP, ETC.
MOVEI T,R6C1
PUSHJ FXP,MKNR6C
JRST RINTERN
R6C1: ILDB A,CORBP ;GET NEXT CHAR FOR READ6C
SKIPE A
ADDI A,40
POPJ P,
MKNAM2: SKIPE A,TMBBC ;GET NEXT CHAR FOR READLIST
JRST MKNAM7
PUSH FXP,T
PUSH FXP,TT
MKNAM3: SKIPN B,MKNM3
JRST MKNAM6
CAIN B,-1
LERR EMS3 ;NOT ENOUGH CHARS IN LIST
PUSHJ P,MKRL1
JRST PXTTTJ
MKNAM6: MOVEI A,203
HLLOS MKNM3
JRST PXTTTJ
MKNAM7: SETZM TMBBC ;TAKE TYIMAN'S BUFFERED-BACK CHAR THIS TIME
POPJ P,
] ;END OF IFE QIO
IFN QIO,[
READLIST: JUMPE A,RDL12
MOVEI B,RDLTYI
MOVEI C,RDLUNTYI
JSP T,SPECBIND
0 A,RDLARG
0 B,TYIMAN
0 C,UNTYIMAN
;; 0 AR1,READPMAN
;; 0 AR2A,UNREADMAN
MOVEI A,RDIN
PUSHJ P,READ0A
SKIPE T,RDLARG ;REALLY OUGHT TO ALLOW
CAIN T,-1 ; A TRAILING SPACE
JRST UNBIND
LERR EMS1 ;TOO MANY CHARS
;;; READLIST PEEK AND TYI ROUTINES. (CF. $DEVICE).
;;; SAVES A,B,C,AR2A; CLOBBERS AR1. RETURNS CHARACTER IN TT.
RDLPEK: JRST RDLPK1 ;RDLTYI-1 IS FOR PEEKING (SEE TYIPEEK)
RDLTYI: PUSH P,A
SKIPN A,RDLARG
JRST RDLTY2
CAIN A,-1
LERR EMS3 ;TOO FEW CHARS
HRRZ AR1,(A)
MOVEM AR1,RDLARG
RDLTY1: HLRZ A,(A)
RDLTY3: JSP T,CHNV1
JRST POPAJ
RDLTY9: SIXBIT \NOT ASCII CHAR!\
RDLTY2: HLLOS RDLARG
MOVEI TT,203 ;PSEUDO-SPACE
JRST POPAJ
RDLPK1: SKIPE TT,RDLARG
CAIN TT,-1
JRST M1TTPJ ;RETURN -1 FOR PEEKING AT "EOF"
PUSH P,A
HLRZ A,@RDLARG
JRST RDLTY3 ;ELSE RETURN CHAR, BUT DON'T FLUSH
RDLUNTYI: MOVEI TT,(A)
JSP T,FXCONS
HRRZ B,RDLARG
PUSHJ P,CONS
MOVEM A,RDLARG
POPJ P,
READ6C: PUSH FXP,A
MOVEI T,R6C1
PUSHJ FXP,MKNR6C
SUB FXP,R70+1
JRST RINTERN
R6C1: ILDB TT,-1(FXP)
JUMPE TT,CPOPJ
ADDI TT,40
JRST POPJ1
] ;END OF IFN QIO
SUBTTL READ FUNCTION
;;; ********** HIRSUTE READER **********
IREAD: MOVEI T,0
IREAD1: SKIPE VOREAD
JCALLF 16,@VOREAD
OREAD:
IFE QIO,[
JSP R,ORD
QOREAD
READ: MOVEI A,RDIN
AOSE RRDF
JRST READ0 ;OOOPS, A RE-ENTRANT CALL TO READ
SETZM RDOBCT ;OK TO CALL RDIN0 NOW.
PUSHJ P,READ0B ;TOP-LEVEL READ
SETOM RRDF ;RESTORE FLAG INDICATING READ RECURSION
] ;END OF IFE QIO
IFN QIO,[
JSP D,INCALL
QOREAD
READ: MOVEI A,QOREAD ;ENABLE TTY PRE-SCAN
HRLM A,BFPRDP
MOVEI A,RDIN
HRRZ T,BFPRDP
JUMPN T,READ0 ;OOOOPS, A RE-ENTRANT CALL TO READ
PUSHJ P,READ0B ;TOP-LEVEL READ
HLLZS BFPRDP
] ;END OF IFN QIO
SKIPA B,RDBKC
READ0: PUSHJ P,REKRD ;RE-ENTRANT READ
TLC T,21000 ;LOSING SPLICING MACROS AT TOP LEVEL
TLCN T,21000
JRST READ ;JUST GO AROUND AND TRY AGAIN
TLNE B,100000 ;IF WE ENDED WITH A PSEUDO-SPACE
TLNN B,40 ; (40-BIT SET IN SPACE SYNTAX),
TLNN T,60 ; OR IF OBJECT WASN'T AN ATOM,
POPJ P, ; THEN DO NOT BUFFER BACK A CHAR
JSP R,RVRCT ;OTHERWISE MUST UNTYI A CHARACTER
IFN QIO,[
EXCH A,C
PUSHJ P,@UNTYIMAN
JRST CRETJ
] ;END OF IFN QIO
IFE QIO,[
SKIPN TYIMAN
SKIPE TAPRED ;THAT NEEDS TO BE SAVED
JRST READ3
EXCH A,C
MOVE B,RDTYBF
PUSHJ P,CONS ;BACKUP ONE CHAR ON THE BUFFERED TTY
SKIPN RDTYBF
HRLM A,RDTYBF
HRRM A,RDTYBF
JRST SPROG3
READ3: SKIPE TYIMAN
JRST READ3A
MOVE D,UTIBP ;BACK UP ONE CHAR IN THE UTAPE BUFFER
DPB C,D ;AND RE-STORE A "(", OR WHATEVER.
ADD D,[070000,,]
JUMPGE D,.+2
SUB D,[430000,,1]
MOVEM D,UTIBP
10$ AOS UTIBYT
POPJ P,
READ3A: MOVEM C,TMBBC ;BACK UP ONE CHAR ON THE TYIMAN
POPJ P,
] ;END OF IFE QIO
;;; ***** HERE IT IS FANS, THE BASIC READER *****
READ0B: HRRZM A,RDINCH ;READ-IN CHANNEL FILTER
JSP T,RSXST
HRRZ A,VIBASE
IFN USELESS,[
CAIN A,QROMAN
JRST RD0BRM
] ;END OF IFN USELESS
SKIPE V.RSET
JRST RD0B1
MOVE TT,(A)
JRST RD0B2
RD0B1: SKOTT A,FX
JRST IBSERR
MOVE TT,(A)
JUMPLE TT,IBSERR
CAIL TT,200
JRST IBSERR
RD0B2:
IFN USELESS, SETZM RDROMP
RD0B2A: MOVEM TT,RDIBS
BG$ SUBI TT,10.
BG$ MOVEM TT,NRD10FL
MOVSI T,3 ;TOP LEVEL, FIRST OF LIST FLAGS
PUSHJ P,RDOBJ1 ;READ ONE OBJECT
HRRZS A
SETZB C,AR1
MOVEI AR2A,0
POPJ P,
IFN USELESS,[
RD0BRM: MOVEI TT,10.
SETOM RDROMP
JRST RD0B2A
] ;END OF IFN USELESS
RVRCT: MOVE C,VREADTABLE
MOVSI TT,-LRCT+2
CAME B,@TTSAR(C)
AOBJN TT,.-1
JUMPGE TT,ER3 ;BLAST? - READ
MOVEI C,(TT)
JRST (R)
READ0A: PUSHJ P,REKRD
TLNN T,4060
RMCER: LERR EMS5 ;READ MACRO CONTEXT ERROR
POPJ P,
REKRD: SAVE RDINCH RDIBS
PUSHJ P,READ0B
REKRD1: RSTR RDIBS RDINCH
POPJ P,
RDOBJ3:
TLNE B,RS%WSP ;TAB,SPACE,COMMA
JRST RDOBJ1
TLNN T,1
POPJ P,
Q% SKIPE RRDF
Q% JRST RMCER
Q$ HRRZ TT,BFPRDP
Q$ JUMPN TT,RMCER
RDOBJ1: JSP TT,RDCHAR ;*** READ ONE OBJECT ROUTINE ***
RDOBJ: NWTN N,B,OBB ;OBJECT BEGIN CHAR - NOT USAGE AT TYIPEEK
JRST RDOBJ3
Q% SKIPL RDOBCT ;IF READ FROM FILE,
Q% AOS RDOBCT ;ERROR TO CALL RDIN0 NOW.
Q$ MOVSI TT,400000 ;REALLY INTO THE READ NOW
Q$ IORM TT,BFPRDP
TLNE B,RS%MAC
JRST RDOBJM ;MACRO CHAR.
TLNE B,RS%SCO
JRST RDCHO1 ;SINGLE CHAR OBJ.
NWTNE B,RS.<LTR+XLT>
JRST RDALPH ;RDOBJ WILL EXIT WITH OBJECT READ
TLNE B,RS%LP ;IN ACC A, AND RCT ENTRY OF BREAK
JRST RDLST ;CHARACTER IN ACC B
NWTNE B,RS.DIG
JRST RDNUM
NWTNE B,RS.SGN
JRST RDOBJ6 ;+,-
MOVE AR1,B
JSP TT,RDCHAR ;DEFAULT IS . <DOT>
TLNN AR1,RS.PNT
JRST RDOBJ0 ;WAS DOTTED PAIR POINT ONLY
NWTNE B,RS.DIG ;IS NEXT CHAR A DIGIT?
JRST RDOBJ5 ;IF SO, THEN MUST BE FLOATING NUM COMING UP
TLNN AR1,RS%DOT
JRST RDJ2A ;IF NOT DOTTED PAIR, THEN TRY ALPHABETIC
RDOBJ0: TLNE AR1,RS%DOT ;*** DOT IS DOTTED-PAIR DOT ***
TLNE T,1
JRST ER2
TLOE T,4 ;LOSE IF ALREADY IN DOTTED PAIR
JRST ER2
JRST RDOBJ ;SO GET SECOND PART OF DOTTED PAIR
;;;. WITH DECIMAL SYNTAX ONLY TURNS INTO SCO, IF FOLLOWED BY BREAK
;;;OR BEGINNING OF ALPHA IF FOLLOWED BY ALPHA
RDJ2A: TLNN B,RS%<BRK+SCO+WSP+LP+DOT+RP+MAC+SLS+RBO>
NWTNN B,RS.<PNT+ARR+SGN+XLT+LTR>
JRST RDCHO4
JRST RDJ2A1
RDOBJ5: TLOA T,200 ;FOUND FLOATING NUM
RDOBJ2: TLO T,10000 ;NUM FORCED WITH "+"
RDJ2A1: JSP TT,IRDA
IDPB AR1,C
AOS D
JRST RDNUM2
RDOBJ6: JSP TT,IRDA ;PROCESS OBJ BEGINNING WITH + OR -
IDPB B,C
SOS D
NWTNE B,RS.ALT
TLO T,400 ;-
JSP TT,RDCHAR
JRST @RDOBJ8 ;CHECK FOR WHITE'S + HAC, USING RD8W, OR DONT BOTHER, USING RD8N
RDJ6A: TLNE B,RS%<MAC+RP+LP+SCO+WSP>
JRST RDOBJ4
NWTNN B,RS.PNT
JRST ER1
MOVE AR1,B
JSP TT,RDCHAR
TLNE T,4
JRST ER1
JRST RDOBJ5 ;+.D DECIMAL FLOATING FORMAT
RDOBJ7: NWTNE B,RS.DIG
JRST RDNUM2 ;+<DECIMAL DIGIT>
TLO T,20 ;+<ALPHA CHARA> OR +<EXTENDED ALPHA>
JRST RDA1
Q$ ER1: LERR MES2
RDOBJ4: TLO T,20 ;SINGLE CHARA "+" OR "-"
JRST RDBK
RD8W: NWTNE B,RS.<DIG+LTR>
JRST RDOBJ2
JRST RDJ6A
RD8N: NWTNE B,RS.<SGN+DIG+LTR+XLT>
JRST RDOBJ7
JRST RDJ6A
RDNUM: JSP TT,IRDA ;*** NUMBER ATOM ***
RDNUM2:
IFE BIGNUM, SETZM AR1 ;FLAG INDICATES HOW MANY DIGITS BEYOND OVERFLOW
RDNM10: SETZB F,R ;BASE 10. NUMBER IN R, BASE IBASE IN F
TLOA T,40
RDNUM1: JSP TT,RDCHAR
NWTNE B,RS.PNT
JRST RDNUM4 ;DECIMAL POINT [WITHOUT BREAK BIT SET]
SOSLE D
IDPB B,C
NWTNE B,RS.DIG
JRST RDNUM5
TLNE T,300 ;ALPHA CHAR SEEN
JRST RDNUM8
NWTNN B,RS.LTR
JRST RDNUM7
TLNN T,10000
JRST RDNUM6
NW% MOVEI TT,(B) ;GET CHTRAN
NW$ HRRZ TT,B
NW$ ANDI TT,177
CAIL TT,"a ;ALLOW FOR LOWER CASE LETTERS
SUBI B,"a-"A
SUBI B,"A-"0-10. ;LETTERS ARE SUPRA-DECIMAL:
JRST RDNUM5 ; A=10., B=11., ..., Z=35.
RDNUM8:
NW% CAIE A,"E ;UPPER AND LOWER CASE E ALLOWED
NW% CAIN A,"e ;MUST TIDY THIS UP SOMEDAY
NW$ TLNE B,RS%SQX ;EXPONENT OR (SOMEDAY) STRING-QUOTE
JRST RDNM8A
NWTNN B,RS.XLT
JRST ER1
RDNUM7: TLNE T,37000 ;EXTENDED ALPHA CHAR SEEN
JRST ER1
NWTNN B,RS.ARR
JRST RDNUM6
NWTNE B,RS.ALT
TLOA T,2000 ;←
TLO T,1000 ;↑
BG$ SKIPN NRD10FL ;IF WE ARE READING IN BASE 10., THEN
BG$ TLO T,100 ; F HAS NOTHING IN IT - SO MUST TAKE R
RDNUM9: TLNN T,140000
JRST RDNM9E
TLNE T,300 ;FOR EXPONENT-IFIED BIGNUMS, RDNSV WILL
HRR AR2A,AR1 ;BE MEANINGLESS
HRLI AR2A,0
TLNE T,400 ;BIGNUM OF CORRECT BASE AND SIGN IS PUT IN AR2A
TLO AR2A,-1
JRST RDNM9B
RDNM9E: TLNE T,300
MOVE F,R
TLNE T,400
MOVNS F
MOVEM F,RDNSV
RDNM9B: TLZ T,500 ;ZERO OUT SIGN AND DECIMAL BITS
MOVEI D,BYTSWD*LPNBUF
JSP TT,RDCHAR
RDNM9C: NWTNN B,RS.<DIG+SGN>
JRST ER1
NWTNN B,RS.SGN
JRST RDNM10
NWTNE B,RS.ALT ;SKIP IF +
TLO T,400
JSP TT,RDCHAR
JRST RDNM10
RDNUM0: IDPB B,C
RDNUM6: TLZ T,340 ;TWAS REALLY AN ALPHA ATOM
TLO T,20
JRST RDA3
RDNM8A: TLZ T,100
TLO T,1200
MOVEM D,RDDSV
JRST RDNUM9
RDNMF: JRST 2,@[.+1] ;CLEAR OUT ALL ARITHMETIC OVERFLOW BITS
MOVE B,T
MOVE TT,F ;FINISHED WITH NUMBER READ, SO PICK UP NUMBER IN BASE IBASE
BG$ SKIPN NRD10FL
BG$ TLO T,100
TLNN T,300
JRST RDNM2
MOVE TT,R ;PICK UP NUMBER IN BASE 10.
IFE BIGNUM,[
JUMPE AR1,RDNM2 ;NUMBER OF OVERFLOW DIGITS IN AR1
TLNN T,200
JRST RDNMER
ADDM AR1,D
ADDM AR1,RDDSV
]
RDNM2: TLNE T,400
MOVNS TT ;NEGATIVE NUMBER, IF INDICATED
BG$ TLNE T,140000
BG$ JRST RDBIGN
RDNM2A: TLNE T,200
JRST RDFLNM
RDFXNM: TLNE T,3000
JRST RDFXEX
RDFX1: JSP T,FIX1A
RDFL1: MOVE T,B
JRST RDNMX
RDNUM5: JFCL 8.,.+1 ;BASIC LOOP THAT INCREMENTALLY ADDS IN ONE DIGIT
IFE BIGNUM, JUMPN AR1,RDNUMC
IFN BIGNUM,[
TLNE T,40000
JRST RDBG10
]
RDNUMD: MOVE TT,R ;BASE 10. VALUE ACCUMULATES IN R
IMULI R,10. ;BASE IBASE VALUE IN F
NW% ADDI R,-"0(B)
NW$ LDB A,[001100,,B]
NW$ ADD R,A
JFCL 8,RD10OV
IFN BIGNUM,[
TLNE T,100000 ;BIGNUM VALUE BASE 10. HELD IN AR1
JRST RDBGIB ;BIGNUM VALUE BASE IBASE HELD IN AR2A
RDNUMB: SKIPN NRD10FL
JRST RDNUM1
]
IFE BIGNUM, RDNUMB:
JFCL 8,.+1 ;MIGHT BE SET IF OVFL ON BASE 10. READIN, WENT TO RD10OV, DID A C1CONS,
MOVE TT,F ;DID A GC, HACKED AROUND AND SET IT AGAIN!
IMUL F,RDIBS
NW% ADDI F,-"0(B)
NW$ LDB A,[001100,,B]
NW$ ADD F,A
JFCL 8,RDIBOV
JRST RDNUM1
IFE BIGNUM,[
RDIBOV: MOVE F,T
MOVE T,TT ;OVERFLOW WHILE ACCUMULATING NUMBER
MUL T,RDIBS ;IN BASE IBASE. TRY TO RECUPERATE
LSH T+1,1 ;TO ALLOW, FOR EXAMPLE, 400000000000
LSHC T,35.
NW% ADDI T,-"0(B)
NW$ ADD T,A
EXCH T,F
JRST RDNUM1
RD10OV: MOVE R,TT
RDNUMC: AOJA AR1,RDNUMB
]
RDFXEX:
IFN BIGNUM, CAIG A,77
TLNE T,600
JRST ER1
EXCH TT,RDNSV
TLNN T,2000
JRST .+3
LSH TT,@RDNSV
JRST RDFX1
IFN BIGNUM,[
SKIPGE TT
TLO T,400
MOVMS TT
RX1: SOSGE RDNSV
JRST RDFX2
TLNE T,100000
JRST RDEX3
]
IFE BIGNUM,[
RX1: SOSGE RDNSV
JRST RDFX1
]
MUL TT,RDIBS
IFN BIGNUM,JUMPN TT,RDEXOF
LSH TT+1,1
LSHC TT,35.
JRST RX1
IFN BIGNUM,[
RDFX2: TLNE T,100000
JRST RDBIGM
TLNE T,400
MOVNS TT
JRST RDFX1
]
RDFLNM: TLNN T,1000
JRST RDFL3
MOVE D,RDDSV
ADD D,TT
AOS D
MOVE TT,RDNSV
RDFL3: HRREI R,-BYTSWD*LPNBUF-1(D)
IFN BIGNUM,[
TLZE T,140000
JRST RDFL3A
]
IDIVI TT,400000
SKIPE TT
TLC TT,254000
TLC TT+1,233000
FADL TT,TT+1
RDFL3A: MOVM T,R
RDFL2A: JUMPGE R,RDL2A2
RDFL2D: SETZ R,
CAIG T,30.
JRST RDL2D3
FSC TT,54. ;SCALE, SO THERE WONT BE UNDERFLOWS
MOVNI R,54.
RDL2D0: FDVL TT,[1.0↑8] ;LOOP FOR MULTIPLYING-IN NEGATIVE POWER OF 10.0
FDVR TT+1,[1.0↑8]
FADL TT,TT+1
SUBI T,8
RDL2D3: CAILE T,8
JRST RDL2D0
JUMPE T,RDFL2E
RDL2D1: FDVL TT,[10.0]
FDVR TT+1,[10.0]
FADL TT,TT+1
SOJG T,RDL2D1
RDFL2E: FADR TT,TT+1
FSC TT,(R)
JFCL 8,RDL2E1
RDL2E0: JSP T,FPCONS
JRST RDFL1
RDL2E1: JSP T,.+1
SKIPE VZUNDERFLOW
TLNN T,100 ;RANDOM FP UNDERFLOW BIT
JRST RDNMER
MOVEI TT,0
JRST RDL2E0
RDL2A0: MOVE TT+2,TT+1 ;LOOP FOR MULTIPLYING-IN POSITIVE POWER OF 10.0
FMPR TT+2,[1.0↑8]
FMPL TT,[1.0↑8]
UFA TT+1,TT+2
FADL TT,TT+2
SUBI T,8
RDL2A2: CAIL T,8
JRST RDL2A0
JUMPE T,RDL2A3
RDL2A1: MOVE TT+2,TT+1
FMPRI TT+2,(10.0)
FMPL TT,[10.0]
UFA TT+1,TT+2
FADL TT,TT+2
SOJG T,RDL2A1
RDL2A3: SETZ R,
JRST RDFL2E
RDLST:
Q$ AOS BFPRDP
PUSH P,T ;*** READ LIST ***
PUSH P,R70 ;POINTER TO LAST OF FORMING LIST
HRLZI T,2
JRST RDLST3
RDLST1: TLZE T,2
JRST RDLS1A
HLR B,(P) ;IFN NEWRD,??
HRRM A,(B)
JRST (TT)
RDLS1A: MOVEM A,(P)
JRST (TT)
RDLST2: PUSHJ P,NCONS
JSP TT,RDLST1
RDLS2A: HRLM A,(P)
RDLS3B: MOVEI T,0
RDLS3A: SKIPA B,AR2A
RDLST3: JSP TT,RDCHAR
PUSHJ P,RDOBJ
TLZE T,4
JRST RDLST4
MOVEM B,AR2A
TLZE T,20000
JRST RDMC
TLNE T,24060 ;EXIT IF NO OBJECT READ
JRST RDLST2
RDLSX: TLNN B,RS%RP
LERR EMS6 ;BLAST, MISSING ")"
POP P,A
POP P,T
Q$ SOS BFPRDP
RDLSX1: MOVSI B,RS%<BRK+WSP> ;THROWAWAY BREAK-CHARACTER
TLO T,4000
POPJ P,
RDMC: TLNN T,4060
JRST RMCER
TLNN T,1000
JRST RDLST2 ;NORMAL MACRO OBJECT
TLZ T,-3
JUMPE A,RDLS3A
JSP TT,RDLST1
JSP AR1,RLAST ;SPLICING MACRO OBJECT
JRST RDLS2A
RDOBJM: TLO T,20000 ;*** MACRO CHARACTER ***
NWTNE B,RS.ALT ;SPLICING?
TLO T,1000 ;SPLICING MACRO
Q% HRR T,RRDF
PUSH P,T
Q% AOS RRDF
SETZM RDBKBF
NW% CALLF 0,(B) ;MACRO CHARACTER HAS LINK IN RH OF
IFN NEWRD,[
LDB D, [001100,,B]
PUSHJ P, GETMAC
HRRZ A, (A)
CALLF 0, (A)
] ;END OF IFN NEWRD
JSP T,RSXST
POP P,T
Q% HRREM T,RRDF
SKIPN B,RDBKBF
JRST RDLSX1
TLO T,60
POPJ P,
RDALPH: TLO T,20 ;*** PNAME ATOM ***
SETOM LPNF
RDA0: JSP TT,IRDA1
RDA1: IDPB B,C
RDA3: JSP TT,RDCHAR
SOJG D,RDA1
MOVEM B,AR2A
PUSHJ FXP,RDA4
MOVE B,AR2A
JRST RDA0
RDA4: PUSHJ P,PNCONS ;ADDS ANOTHER SEGMENT TO A LONG PNAME LIST
AOSN LPNF
PUSH P,R70
MOVE B,(P)
EXCH A,B
PUSHJ P,.NCONC
MOVEM A,(P)
POPJ FXP,
RDLST4: TLNE T,2 ;*** DOT PAIR ***
JRST ER2
TLZ T,60
MOVS TT,(P)
HRRM A,(TT)
TLZE T,20000
JRST RDLS4A
RDLS4B: TLNE B,RS%RP ;RIGHT PAREN?
JRST RDLSX
NWTN E,B,WTH ;SKIP IF NOT WORTHY CHAR
JRST RDLS4C
JSP TT,RDCHAR ;IF CHAR IS UNWORTHY, THEN FLUSH IT AND TRY AGAIN
JRST RDLS4B
RDLS4A: TLZN T,1000
JRST RDLS4B
MOVE AR2A,RCT0+".
JUMPE A,RDLS3B
JSP AR1,RLAST
JRST RDLS2A
RDLS4C: TLNE B,RS%MAC
NWTNN B,RS.ALT
JRST ER2
PUSHJ P,RDOBJM ;SPLICING MACRO
JUMPE A,RDLS4B
HLRZ AR2A,(P)
HRRZ C,(AR2A)
HRRM A,(AR2A)
JSP AR1,RLAST
HRRM C,(A)
HRLM A,(P)
JRST RDLS4B
RLAST: JUMPE A,(AR1)
RLAST1: HRRZ TT,(A)
JUMPE TT,(AR1)
LSH TT,-SEGLOG
SKIPL ST(TT)
JRST RMCER
HRRZ A,(A)
JRST RLAST1
RDCHO1: MOVE AR1,B
NWTNN B,RS.PNT
JRST RDCHO3
JSP TT,RDCHAR ;. AS SCO ALSO HAS DECIMAL PT. SYNTAX
NWTNE B,RS.DIG
JRST RDOBJ5 ;WILL TAKE AS FLOTING PT. NUM
NWTN N,B,WTH ;SKIP IF WORTHY CHAR
JRST RDCHO3 ;CAN TOSS OUT NEXT UNWORTHY CHAR
RDCHO4: PUSH FXP,B ;OTHERWISE, SAVE NEXT CHAR AS IF IT WERE IMPORTANT BREAK CHAR
SKIPA C,[RDCHO2]
RDCHO3: MOVEI C,RDLSX1
MOVE B,AR1
PUSH P,C
RDCHO: JSP TT,IRDA ;*** SINGLE CHARA OBJECT ***
SETZM PNBUF
IDPB B,C
JRST RINTERN
RDCHO2: POP FXP,B ;AFTER MAKING UP . AS SCO,
MOVEM B,RDBKC ;MAKE NEXT CHAR LOOK LIKE
TLO T,20 ;IMPORTANT BREAK CHAR
POPJ P,
IFN BIGNUM,[
RD10OV: TLO T,40000
JSP A,RDRGSV
PUSHJ P,C1CONS
MOVE AR1,A
JRST RDBG1A
RDIBOV: TLO T,100000
JSP A,RDRGSV
PUSHJ P,C1CONS
MOVE AR2A,A
JRST RDBGIA
RDBG10: TLNE T,3000
JRST RDNUMD ;GETTING EXPONENT MODIFIER
JSP A,RDRGSV
RDBG1A: MOVE T,AR1
MOVEI D,-"0(B)
NW$ ANDI D,177
MOVEI TT,10.
PUSHJ P,.TM.PL
MOVE T,TSAVE
TLNE T,100000
JRST RDBGIA
JSP A,RDRGRS
JRST RDNUMB
RDBGIB: TLNE T,3000
JRST RDNUMB ;GETTING EXPONENT MODIFIER
JSP A,RDRGSV
RDBGIA: MOVE T,AR2A
MOVE TT,RDIBS
MOVEI D,-"0(B)
NW$ ANDI D,177
PUSHJ P,.TM.PL
JSP A,RDRGRS
JRST RDNUM1
.RDMULP: SKIPA T,A
.TIMER: MOVEI D,0 ;T IS LIST OF DIGITS, TT IS MULTIPLIER,
.TM.PL: HLRZ A,(T) ;D IS CARRY.
MOVE R,(A)
MUL R,TT
ADD R+1,D
TLZE R+1,400000
AOS R
MOVEM R+1,(A)
MOVE D,R
HRRZ A,(T)
JUMPN A,.RDMULP
JUMPE D,CPOPJ
MOVE TT,D
PUSHJ P,C1CONS
HRRM A,(T)
POPJ P,
;;; IFN BIGNUM
RDRGSV: MOVEM T,TSAVE
MOVEM D,DSAVE
MOVEM R,RSAVE
MOVEM F,FSAVE
JRST (A)
RDRGRS: MOVE T,TSAVE
MOVE D,DSAVE
MOVE R,RSAVE
MOVE F,FSAVE
JRST (A)
RDEXOF: TLO T,100000
PUSH FXP,TT+1
PUSHJ P,C1CONS
MOVE B,A
POP FXP,TT
PUSHJ P,C1CONS
HRRM B,(A)
TLNE T,400
TLO A,-1
JRST RX1
RDEX3: PUSH P,A
MOVEM T,TSAVE
MOVE T,A
MOVE TT,RDIBS
PUSHJ P,.TIMER
MOVE T,TSAVE
POP P,A
JRST RX1
RDBIGN: TLNE T,3000
JRST RDBGEX
HRLI A,0 ;CREATE BIGNUM SIGN
TLNE T,400
TLO A,-1
TLNE T,100000
TLNE T,300
JRST RDCBG
HRR A,AR2A
RDBIGM: PUSHJ P,BNTRSZ
MOVE TT,[400000,,0]
JRST RDFX1
PUSHJ P,BNCONS
MOVE B,RDBKC
POPJ P,
;;; IFN BIGNUM
RDBGEX: TLNE T,200
JRST RDBXFL
MOVEI D,1
TLNE T,2000
JRST RDBFSH
JUMPLE TT,RDBGXM
IMUL D,RDIBS ;<BIGNUM>↑(TT)
SOJG TT,.-1
RDBGXM: MOVE TT,D
MOVEM T,TSAVE
HRRZ T,AR2A
PUSHJ P,.TIMER
MOVE A,AR2A
MOVE T,TSAVE
JRST RDBIGM
RDBFSH: LSH D,(TT) ;<BIGNUM>←(TT)
JRST RDBGXM
RDBXFL: ADD TT,RDDSV
SUBI TT,BYTSWD*LPNBUF
MOVE A,AR2A
JRST RDCBG1
RDCBG: TLNN T,300
JRST RDNM2B
HRR A,AR1
TLNN T,200
JRST RDBIGM
HRREI TT,-BYTSWD*LPNBUF-1(D)
RDCBG1: PUSH FXP,TT ;THIS IS THE POWER-OF-TEN EXPONENT
MOVE TT,A
PUSHJ P,FLBIGZ
POP FXP,R
JFCL 8.,RDNMER
JUMPGE A,RDFL3A
DFN TT,TT+1
JRST RDFL3A
RDNM2B: TLZ T,140000 ;A BIGNUMBER BASE 10. WAS REALLY A REGNUM
JRST RDNM2A ;BASE IBASE, BUT BIG ENOUGH TO OVFLO BASE 10. CALC
] ;END OF IFN BIGNUM
SUBTTL READER SINGLE-CHARACTER FILTER
;;; ***** READ ONE CHARACTER (FOR READ) *****
RDCHAR: PUSHJ P,@RDINCH
MOVE B,@RSXTB
RDCH1:
NW% JUMPGE B,(TT)
NW$ NWTNE B,RS%BRK
NW$ JRST (TT)
NWTN E,B,[<SQX+SCO+WSP+LP+DOT+RP+MAC+PNT>]
JRST RDBK ;BREAKING CHAR FOUND
NWTN N,B,WTH
JRST RDCHAR ;WORTHLESS CHAR
TLNN B,RS%SLS
JRST (TT) ;ALPHABETIC CHAR WITH BREAK BIT SOMEHOW SET
PUSHJ P,@RDINCH ;/
NW% HRR B,A ;PUT EXTENDED ALPHABETIC SYNTAX ON THIS CHAR
NW% HRLI B,2
NW$ MOVEI B,RS.XLT(A)
JRST (TT)
RDBK: MOVEM B,RDBKC
TLNN T,60
JRST (TT)
TLNN T,20
JRST RDNUM4
PUSHJ FXP,RDAEND
IFN USELESS, SKIPE RDROMP
IFN USELESS, PUSHJ P,RDROM
PUSHJ P,RINTERN
RDNMX: MOVE B,RDBKC
POPJ P,
RDNUM4: TLNN T,300
TLNN B,200
JRST RDNM4A
PUSHJ P,@RDINCH ;. FOUND
MOVE B,@RSXTB
NWTN N,B,SEE
JRST .-3 ;CONTROL-CHARS ARE IGNORED
MOVEI D,BYTSWD*LPNBUF+1
NWTNE B,RS.DIG
TLOA T,200
TLO T,100
JRST RDCH1
RDNM4A: TLNE B,RS.SGN
TLNN T,3000
JRST RDNMF ;TERMINATES A NUMBER TOKEN, UNLESS A SIGN IS
JRST (TT) ;FOLLOWING AN EXPONENTIATOR
IFN USELESS,[
RDROM: SKIPGE LPNF
SKIPN PNBUF
POPJ P,
PUSH FXP,C
MOVE C,[440700,,PNBUF]
SETZB TT,D
RDROM1: ILDB F,C
JUMPN F,RDROM2
PUSH FXP,T
JSP T,FXCONS
POP FXP,T
SUB FXP,R70+1
JRST POPJ1
RDROM2: SETZ R,
IRP X,,[M,D,C,L,X,V,I]N,,[1000.,500.,100.,50.,10.,5,1]
CAIN F,"X
MOVEI R,N
TERMIN
JUMPE R,RDROM7
ADDI TT,(R)
CAIG R,(D)
JRST RDROM3
REPEAT 2, SUBI TT,(D)
RDROM3: MOVEI D,(R)
JRST RDROM1
RDROM7: POP FXP,C
POPJ P,
] ;END OF IFN USELESS
RDAEND: LSHC B,6
DPB B,[360600,,C]
SETZM B
LSHC B,-6
DPB B,C
SKIPGE LPNF
POPJ FXP,
PUSHJ P,PNCONS ;DESTROYS TT
POP P,B
EXCH A,B
PUSHJ P,.NCONC
POPJ FXP,
IRDA: SETOM LPNF ;INITIALIZE FOR READING PNAME-TYPE ATOM
IRDA1: MOVE C,PNBP
MOVEI D,BYTSWD*LPNBUF
JRST (TT)
IFE QIO,[
RDIN: SKIPE A,TYIMAN ;;; NORMAL READ-IN CHANNEL FILTER
JRST (A)
SKIPN TAPRED
JRST RDIN1
PUSHJ P,URED
RDIN3A: SKIPA A,READ ;READ CONTAINS "RDIN"
POPJ P,
JRST .UEOF
RDIN1: SKIPE B,RDTYBF
JRST RDIN2
PUSHJ P,RDIN0
JUMPN A,RDIN ;IF TAPRED NON-NIL, TRY AGAIN
MOVE B,RDTYBF
RDIN2: HRRZ A,(B)
JUMPE A,.+2
HLL A,B
MOVEM A,RDTYBF
HLRZ A,(B)
POPJ P,
] ;END OF IFE QIO
IFN QIO,[
RDIN: PUSHJ FXP,SAV5M1
PUSHJ P,SAVX5
PUSHJ P,@TYIMAN
MOVEI A,(TT) ;***** GRUMBLE *****
PUSHJ FXP,RST5M1
JRST RSTX5
] ;END OF IFN QIO
SUBTTL BUILT-IN MACRO CHARACTER PROCESSORS
;;; SINGLE QUOTE PROCESSOR:
;;; 'FOO => (QUOTE FOO)
RDQTE: PUSHJ P,READ ;FOR THE WHITE SINGLE-QUOTE HAC
PUSHJ P,NCONS
MOVEI B,QQUOTE
JRST XCONS
;;; SEMICOLON COMMENT PROCESSOR: (SPLICING)
;;; ; -- ANYTHING -- <CR> => NIL, HENCE IGNORED
RDSEMI: PUSHJ P,RDSMI0
JUMPE A,CPOPJ ;OK, FOUND CR
LERR EMS10 ;HMMM, HIT E-O-F BEFORE CR
RDSMI0: MOVNI T,1
PUSH P,T
Q% JSP R,ORD
Q$ JSP D,INCALL
QRDSEMI ;THIS SHOULD NEVER [!!] BE USED
RDSMI1: PUSHJ P,TYI
CAIE A,15 ;CR
JRST RDSMI1
JRST FALSE
;;; VERTICAL BAR PROCESSOR:
;;; |ANYTHING| => /A/N/Y/T/H/I/N/G
;;; I.E. IT IS A SUPER SYMBOL QUOTER (ALMOST LIKE ""'S)
RDVBAR: PUSH FXP,R70
Q% JSP T,RSXST
Q$ JSP T,GTRDTB
MOVEI T,RDVB3
PUSHJ FXP,MKNR6C
SUB FXP,R70+1
JRST RINTERN
RDVB2: SETOM -1(FXP)
RDVB3: PUSH FXP,D
PUSHJ P,TYI
POP FXP,D
Q% CAIN A,↑M
Q$ CAIN TT,↑M
JRST RDVB2
Q% CAIN A,↑J
Q$ CAIN TT,↑J
SKIPN -1(FXP)
JRST RDVB4
SETZM -1(FXP)
JRST RDVB3
RDVB4: SETZM -1(FXP)
Q% CAIN A,"|
Q% JRST FALSE
Q$ CAIN TT,"|
Q$ POPJ P,
Q% SKIPGE T,@RSXTB
Q$ SKIPGE T,@TTSAR(AR2A)
TLNN T,2000
JRST POPJ1
PUSH FXP,D
PUSHJ P,TYI
POP FXP,D
Q% CAIN A,↑M
Q$ CAIN TT,↑M
SETOM -1(FXP)
JRST POPJ1
IFN QIO,[
;;; SPLICING MACRO CHARACTER FUNCTIONS FOR ↑Q AND ↑S.
CTRLQ: MOVEI A,TRUTH
MOVEM A,TAPRED
JRST FALSE
CTRLS: SETZM TTYOFF
JRST TERPRI
] ;END OF IFN QIO
IFE QIO,[
SUBTTL OLD I/O TTY PRESCAN, AND RUBOUT HANDLER
;;; ROUTINE TO READ ONE S-EXP FROM TTY AND FILL UP BUFFER FOR TYIN.
RDIN0: SAVE C AR2A
PUSHJ P,SAVX5
SKIPLE RDOBCT ;ERROR IF ANYTHING SIGNIFICANT READ FROM FILE.
LERR EMS10 ;GOT TO TTY INSIDE S-EXP - READ
RDTIN1: SETZB AR2A,RDTYBF
Q% JSP T,IRD0S3
Q$ JSP T,SAVCIC
JRST RDTIN2
RDTTY: PUSHJ P,RDTTY0
RDIN3B:
MOVE B,@RSXTB
JUMPL B,RDTIN4
RDTIN3: JSP T,RD0A
CRDTTY: JRST RDTTY
RDTIN4: CAIN A,↑M
SKIPN LINMODE
JRST RDTN4A
JUMPG AR2A,RDTFF
MOVEI A,203
JSP T,RD0A
MOVEI A,↑M
JRST RDTFF
RDTN4A: TLNE B,RS%<RBO+FF>
JRST RDTRB ;RUBOUT OR FORCED FEED CHAR
SA$ CAIL A,200
SA$ JRST RDTFF
TLNE B,RS%WSP
JRST RDTSPC
TLNE B,RS%MAC
JRST RDTPM
TLNE B,RS%SCO
JRST RDTPO
TLNE B,RS%<LP+RP>
JRST RDTPR ;PARENS
TLNE B,RS%SLS
JRST RDTSH ;SLASHING CHARACTER, E.G. /
TLNE B,RS%DOT
JRST RDTIN3 ;DOTTED PAIR KIND OF DOT
SA$ CAIN A,325
SA% CAIN A,↑U
JRST RDTN2A
SA$ CAIN A,313
SA% CAIN A,13 ;JPG'S "SOFT" FORM FEED
JRST RDTN5A
SA$ CAIN A,314
SA% CAIN A,14 ;FORM FEED [CONTROL-L]
JRST RDTIN5
JSP T,RD0A ;RANDOM WORTHLESS CHAR
RDTIN2: SKIPN TAPRED
JRST RDTTY ;IF STILL READING FROM TTY, CONTINUE.
SETZB AR2A,RDTYBF ;ELSE, RESTART READING.
SETZM RDOBCT ;WITHDRAW AUTOMATIC PERMIT TO RDIN0.
JRST RD0F
RDTN2A:
10$ OUTSTR [ASCIZ \↑U\]
PUSHJ P,TTYTRP
IFE D10,[
SKIPN TTYDISP .SEE %TNPRT
JRST RDTIN1 ;HAC WONT WORK FOR PRINTING TERMINALS
MOVEI D,RD0S3
PUSHJ P,SRNTYP
MOVEI D,[ASCIZ \⊂E\]
PUSHJ P,SRNTYP
] ;END OF IFE D10
JRST RDTIN1
;;; IFE QIO
RDTPR: TLNE B,RS%LP
AOJA AR2A,RDTPM ;(
SOJG AR2A,RDTIN3 ;)
RDTSPC: JSP T,RDTINX
JSP T,RD0A ;TTY READ SPACE, OR PARENS BALANCE
JUMPG AR2A,RDTTY
RDTX2: MOVEI A,0
SETOM RDOBCT ;OK TO CALL RDIN0 AGAIN.
RD0F: RSTR AR2A C
JRST RSTX5
RDTPO: SKIPN RDTYBF ;SCO TREATED LIKE MACRO UNLESS IT IS ONLY CHAR IN TTY BUFFER
JRST RDTPO1
RDTPM: JSP T,RDTINX
HRRZM A,PBFTY ;TERMINATED TOP-LEVEL ATOM WITH BREAK CHAR OTHER THAN SPACE
MOVEI A,203 ;SO PUT IT BACK, AND SIMULATE A SPACE
RDTFF: JSP T,RD0A
JRST RDTX2
RDTPO1: JSP T,RDTNX1
JRST RDTFF
RDTINX: JUMPG AR2A,RDTIN3
SKIPN RDTYBF
JRST RDTIN3
RDTNX1: SKIPE LINMODE
JRST RDTIN3
MOVEI C,(A)
MOVEI A,LRCT-2
HLRZ A,@RSXTB ;TEST IF TERMINATE ONLY ON FORCE-FEED CHAR
EXCH A,C
JUMPE C,RDTIN3
JRST (T)
;;; IFE QIO
RDTSH: JSP T,RD0A ;SLASH, OR QUOTING CHARACTER
PUSHJ P,RDTTY0
JRST RDTIN3
RDTRB:
NW$ TLNN B,RS%FF
NWTNE B,RS.ALT
JRST RDTFF
SKIPE RDTYBF ;TTY READ RUBOUT
JRST RDTRB1
MOVEI A,LRCT-2
HLRZ A,@RSXTB ;DO END-OF-FILE THING IF RUB OUT BEYOND INPUT
SKIPE EOFRTN
JUMPE A,RDTRB3 ;BUFFER, BUT ONLY IF (STATUS TTYREAD) = NIL
PUSHJ P,TTYTRP
JRST RDTIN1
RDTRB1: PUSHJ P,RD0S
SKIPN RDTYBF
JRST RDTIN1
MOVE B,@RSXTB
HLRZ A,RDTYBF
HLRZ A,(A)
MOVE A,@RSXTB
TLNE A,RS%SLS
JRST RDTRB2 ;RUBBED OUT SLASHIFIED CHARA
TLCN B,RS%<LP+RP>
JRST RDTTY
TLNE B,RS%LP
AOJA AR2A,RDTTY
SOJA AR2A,RDTTY
RDTRB2: PUSHJ P,RD0S
JRST RDTTY
RD0A: MOVEM B,C
PUSHJ P,NCONS ;ADD CHARA TO TTY BUF LIST
SKIPN B,RDTYBF
JRST RD0A1
MOVSS B
HRRM A,(B)
HRLM A,RDTYBF
RD0A2: MOVE B,C
JRST (T)
RD0A1: HRLS A
MOVEM A,RDTYBF
JRST RD0A2
RDTTY0: SKIPE A,TYIMAN
JRST (A)
JRST TYIN
;;; IFE QIO
RD0S: MOVE B,RDTYBF ;DELETE CHARA OF END OF TTY BUF LIST
HLRZ A,B ;LEAVES RUBBED OUT CHAR IN A
CAIE A,(B)
JRST RD0S1A
SETZM RDTYBF
HLRZ A,(B)
RD0S2:
IFN D10, JRST TTYECO
IFE D10,[
SKIPE D,TTYDISP
TLNN D,%TOERS
JRST TTYECO
TLNN D,%TOMVU
JRST TTYECO
CAIN A,177 ;RUBOUT DOESN'T PRINT, HENCE NO NEED TO WIPE OUT
POPJ P,
JRST RD0S5 ;GOODIES TO RE-POSITION CURSOR AND RUB OUT!
] ;END OF IFE D10
RD0S1: MOVEI B,(C)
RD0S1A: HRRZ C,(B)
CAIE C,(A)
JRST RD0S1
HLRM C,(B)
HRLM B,RDTYBF
HLRZ A,(C)
JRST RD0S2
RDTN5A: PUSHJ P,TTYTRP ;CONTROL-K FEATURE
JRST RDTN5B
RDTIN5: SKIPN TTYDISP ;CONTROL-L FEATURE
PUSHJ P,TTYTRP
PUSHJ P,CLRSRN
RDTN5B:
JSP T,IRD0S3 ;INITIALIZE SLOT WHERE TTY ECHO IS KNOWN TO BEGIN
PUSH P,CRDTTY
RDTN5C: HRRZ A,RDTYBF ;SPLAT OUT THE RDTYBF AS IT STANDS
MOVEI B,QTTYECO ;USED AS A KIND OF PROGRAMED ECHO
JRST .MAP+2
;;; IFE QIO
IFN D10,[
TTYECO: CAIN A,33 ;DEC LOSES ALTMODES
JRST OUT$
OUTCHR A
POPJ P,
IRD0S3: JRST (T)
CLRSRN: POPJ P,
TTYTRP: OUTSTR [ASCIZ \
\]
POPJ P,
OUT$: OUTCHR .+1
POPJ P,"$
] ;END OF IFN D10
IFE D10,[
TTYECO: CAIN A,20
JRST ECOCNP
MOVEI D,CNPRBR ;CONTROL-P RIGHT-BRACKET
SKIPE TTYDISP
CAIE A,15 ;CR
JRST RTECO
PUSHJ P,SRNTYP
JRST RTECO
ECOCNP: .IOT TYOC,A ;RIGHT WAY TO ECHO ↑P IS
.IOT TYOC,C120 ; AS "↑P P" - ITS DOES THE REST
POPJ P,
RTECO: .IOT TYOC,A
C136: POPJ P,136
IRD0S3: SKIPN TTYDISP .SEE %TNPRT
JRST (T) ;CAN HAC FOR PRINTING TERMINALS
.CALL RCPSBK ;SAVE CURSOR VERTICAL POSITION SO THAT WE WILL
.VALUE ; KNOW WHERE TO BEGIN A COMPLETE ECHO REPRINT
HLRZS D
ADDI D,10
LSH D,29.
MOVEM D,RD0S3+1
JRST (T)
CLRSRN: SKIPN TTYDISP
POPJ P,
MOVEI D,CNPC ; ↑P C
JRST SRNTYP
CNPC: ASCIZ \⊂C\
TTYTRP: .IOT TYOC,C15
C120: POPJ P,120
RD0S5: .CALL RCPSBK ;GET TTY CURSOR POSITION
.VALUE
MOVEI D,(D) ;IF CURSOR IS NOT AT LEFT MARGIN
JUMPE D,RD0S4 ;CAN SIMPLY BACKSPACE
MOVEI D,CNPRB1 ; ↑P B ↑P RIGHT-BRACKET
CAIN A,11
JRST RD0S4 ;FOR LOSING TABS MUST ALSO REDISPLAY
CAIL A,40 ;CONTROL CHARS TAKE TWO POSITIONS
JRST RD0S5A
CAIE A,33 ;EXCEPT ALTMODE
MOVEI D,CNPRB2 ; ↑P B ↑P B ↑P RIGHT-BRACKET
RD0S5A: CAIN A,12 ;LINE FEEDS ARE REALLY STRANGE
MOVEI D,CNPRU1 ; ↑P U ↑P RIGHT-BRACKET
CAIN A,10 ;SO ARE BACKSPACES
MOVEI D,CNPFWD ; ↑P F RUBOUT
CAIE A,37 ;↑← REQUIRES REDISPLAY
JRST SRNTYP
RD0S4: MOVEI D,RD0S3 ;OTHERWISE, MUST TRY TO RE-POSITION
PUSHJ P,SRNTYP ; CURSOR, AND RE-TYPE INPUT BUFFER.
PUSH P,A
PUSHJ P,RDTN5C
MOVEI D,CNPRBR ;↑P RIGHT-BRACKET
PUSHJ P,SRNTYP
JRST POPAJ
CNPRBR: ASCIB [⊂)]
CNPRB1: ASCIB [⊂B⊂)]
CNPRB2: ASCIB [⊂B⊂B⊂)]
CNPRU1: ASCIB [⊂U⊂)]
CNPFWD: ASCIB [⊂F?]
] ;END OF IFE D10
] ;END OF IFE QIO
IFN QIO,[
SUBTTL NEWIO TTY PRESCAN, RUBOUT HANDLER, AND READLINE
;;; INITIAL TTY CHARACTER BUFFERING ROUTINE.
;;; BUFFERS UP A LIST OF CHARACTERS FOR TTY INPUT.
;;; HANDLES ALL APPROPRIATE RUBOUT PROCESSING.
;;; ARGUMENTS ARE A TTY INPUT FILE ARRAY IN A,
;;; THE FUNCTION TO BUFFER FOR IN B (E.G. QOREAD),
;;; AND THE COUNT OF UNMATCHED LEFT PARENS IN C.
;;; RUBOUT ECHOING IS PERFORMED ON THE ASSOCIATED OUTPUT
;;; TTY, IF ANY. HAIRY ERASING RUBOUT IS DONE FOR DISPLAYS.
;;; NO RUBOUT HACKING IS DONE IF THERE IS NO ECHO FILE.
TTYBUF: JSP T,SPECBIND
VECHOFILES
0 A,VINFILE
CAIN A,TRUTH
HRRZ A,V%TYI
PUSH FXP,(C)
CAIE C,QOREAD
SETZM (FXP)
JSP T,GTRDTB ;GET READTABLE;AR2A 4.9 = USEFULP
CAIN B,Q%READLINE ;AR2A 4.9 => USEFULP
TLO AR2A,200000 ;AR2A 4.8 => READLINE
MOVEI TT,FT.CNS ;GET ASSOCIATED OUTPUT TTY
SKIPE C,@TTSAR(A) ; (THE SIGN BIT TELLS TYO6 THIS IS ONE FILE)
PUSHJ P,TTYBRC ;MAYBE GET CURCOR POSITION IN D
TTYB0: PUSH FXP,D
PUSH FXP,-1(FXP) ;PARENS COUNT
MOVEI TT,F.MODE
MOVE R,@TTSAR(AR1) ;GET INPUT FILE MODE BITS
PUSH FXP,R
PUSH FXP,XC-1 ;PUSH -1 (NOT IN STRING YET)
SETZ B, ;B HOLDS LIST OF CHARACTERS
PUSH P,BFPRDP
HRRZS BFPRDP ;WE WANT NO CLEVERNESS FROM $DEVICE
;STATE OF THE WORLD:
; B HAS LIST OF BUFFERED CHARS (IN REVERSE ORDER)
; C HAS TTY OUTPUT FILE ARRAY
; AR2A HAS READTABLE
; 4.9 => USEFUL CHAR SEEN
; 4.8 => READLINE INSTEAD OF READ
; VINFILE HAS TTY INPUT FILE ARRAY
; P: OLD CONTENTS OF BFPRDP
; FXP: STRING TERMINATOR CHAR (-1 IF NOT IN STRING)
; MODE BITS FOR INPUT FILE
; PARENTHESIS COUNT
; SAVED CURSOR POSITION
; ORIGINAL PARENS COUNT
TTYB1: PUSHJ P,TTYBCH ;GET A CHARACTER
MOVE D,@TTSAR(AR2A) ;GET READTABLE SYNTAX
MOVE R,-1(FXP) ;GET MODE BITS
CAIE TT,↑M
JRST TTYB7
TLNE AR2A,200000 ;CR TERMINATES READLINE
JRST TTYB9
TLNN R,FBT<LN> ;SKIP IF LINE MODE
JRST TTYB2
MOVEI TT,203 ;PSEUDO-SPACE
TLNN AR2A,200000 ;SKIP IF HACKING A STRING
JSP R,TTYPSH ;ELSE PUSH CHAR ONTO BUFFER
MOVEI TT,↑M
JRST TTYB9 ;ALL DONE
TTYB7: CAIE TT,↑K ;FOR A ↑K, WE TERPRI
JRST TTYB7F ; AND THEN RETYPE THE BUFFER
TTYB7E: SKIPN AR1,C
JRST TTYB1
PUSHJ P,ITERPRI
JRST TTYB7N
TTYB7F: CAIE TT,↑L ;FOR ↑L, WE CLEAR THE SCREEN,
JRST TTYB2 ; THEN RETYPE THE BUFFER
SKIPN AR1,C
JRST TTYB1
MOVEI TT,F.MODE
MOVE R,@TTSAR(AR1)
TLNN R,FBT<CP> ;IF WE CAN'T CLEAR THE SCREEN,
JRST TTYB7E ; WE JUST MAKE LIKE ↑K
PUSHJ P,CLRSRN
TTYB7N: MOVEI TT,F.CHAN ;READ THE TTY CURSOR POSITION
.CALL RCPOS ;(MAYBE WE SHOULD FORCE BUFFER?)
.VALUE ;*** MAYBE AN IOJRST HERE
MOVEI TT,F.MODE
MOVE F,@TTSAR(AR1)
TLNE F,FBT<EC>
MOVE D,R
MOVEM D,-3(FXP)
PUSHJ P,TTYBLT ;ZAP OUT TTY BUFFER
JRST TTYB1
TTYB2: TLNN AR2A,200000 ;READLINE IGNORES SLASHES
TLNN D,2000 .SEE SYNTAX ;SLASH
JRST TTYB4
JSP R,TTYPSH
PUSHJ P,TTYBCH
TLO TT,400000 ;SLASHIFIED CHAR
TTYB3: TLO AR2A,400000 ;USEFUL FROB SEEN
TTYB3A: JSP R,TTYPSH
JRST TTYB1
TTYB4: TLNE D,1000 .SEE SYNTAX ;RUBOUT
TLNE D,40 .SEE SYNTAX ;NOT SECOND CHOICE
JRST TTYB5
JUMPN B,TTYB4C
HRRZ T,BFPRDP
JUMPE T,TTYB9J ;RETURN TO CALLER FOR EOF
SKIPE AR1,C ;OOPS! INSIDE READ ALREADY!
PUSHJ P,ITERPRI ; WE MUST SIMPLY TERPRI
JRST TTYB1 ; (IF POSSIBLE) AND TRY IT AGAIN
TTYB4C: PUSHJ P,RUB1CH ;RUB OUT CHAR
SKIPL TT,(A) ;SKIP IF CHAR WAS SLASHIFIED
JRST TTYB4G
PUSHJ P,RUB1CH ;RUB OUT SLASH TOO
JRST TTYB1
TTYB4G: SKIPL (FXP) ;SKIP UNLESS IN STRING
JRST TTYB4J
TLNE TT,100000
JRST TTYB4M
MOVE D,@TTSAR(AR2A) ;GET CHARACTER SYNTAX
TLNE D,40000 .SEE SYNTAX ;OPEN PAREN
SOS -2(FXP)
TLNE D,10000 .SEE SYNTAX ;CLOSE PAREN
AOS -2(FXP)
JRST TTYB1
TTYB4J: TLNE TT,200000 ;RUBBED OUT BACK OUT OF STRING
SETOM (FXP)
JRST TTYB1
TTYB4M: HRRZM TT,(FXP) ;RUBBED OUT BACK INTO A STRING
JRST TTYB1
TTYB5: TLNE AR2A,200000 ;GO BACK AROUND IF READLINE
JRST TTYB3A
SKIPGE R,(FXP) ;SKIP IF IN STRING
JRST TTYB5H
CAIE R,(TT)
JRST TTYB3A
TLO TT,100000 ;MARK AS STRING END
SETOM (FXP)
JRST TTYB3A
TTYB5H: TLNE D,1000 .SEE SYNTAX ;FORCE FEED
TLNN D,40 .SEE SYNTAX ;SECOND CHOICE
JRST TTYB5K
TTYB9: JSP R,TTYPSH
JUMPE C,TTY9B
PUSHJ P,TTYBRC
MOVEI TT,AT.LNN ;UPDATE LINENUM AND CHARPOS
HLRZM D,@TTSAR(C) ; OF ASSOCIATED OUTPUT FILE
MOVEI TT,AT.CHS
HRRZM D,@TTSAR(C)
TTY9B: MOVEI A,(B)
PUSHJ P,NREVERSE
MOVEI B,(A)
MOVEI C,(A)
TTYB9D: JUMPE C,TTYB9J
HLRZ A,(C)
MOVE TT,(A)
TLZE TT,-1
JSP T,FXCONS
HRLM A,(C)
HRRZ C,(C)
JRST TTYB9D
TTYB9J: SUB FXP,R70+5
POP P,BFPRDP ;RESTORE BFPRDP
MOVEI A,(B)
JRST UNBIND
TTYB5K: TLNN D,100000 .SEE SYNTAX ;SPACE
JRST TTYB6
TTYB5M: JSP T,TTYATM
JSP R,TTYPSH
JRST TTYB1
TTYB6: TLNN D,200000 .SEE SYNTAX ;SINGLE CHAR OBJECT
JRST TTYB6C
TLO AR2A,400000 ;USEFUL THING SEEN
JRST TTYB5M
TTYB6C: MOVEI R,(D)
MOVEI F,↑M
CAIN R,QRDSEMI
JRST TTYB6F
MOVEI F,(TT)
CAIE R,QRDVBAR
JRST TTYB6J
TLO AR2A,400000 ;USEFUL FROB SEEN
TTYB6F: JSP T,TTYATM
TLO TT,200000 ;STRING BEGIN
MOVEM F,(FXP)
JRST TTYB3
TTYB6J: TLNN D,40000 .SEE SYNTAX ;OPEN PAREN
JRST TTYB6Q
AOS -2(FXP)
JRST TTYB3
TTYB6Q: TLNN D,10000 .SEE SYNTAX ;CLOSE PAREN
JRST TTYB8
JSP T,TTYATM
SOSG -2(FXP)
JRST TTYB9
JRST TTYB3
TTYB8: TLNE D,277237 .SEE SYNTAX ;SKIP IF NOT WORTHY CHAR
JRST TTYB3
JRST TTYB3A
;;; IFN QIO
RCPOS: SETZ
SIXBIT \RCPOS\ ;READ CURSOR POSITION
,,@TTSAR(AR1) ;TTY CHANNEL #
2000,,D ;MAIN PROGRAM CURSORPOS
402000,,R ;ECHO AREA CURSORPOS
TTYBRC: HRROS AR1,C ;GET CURSOR POSITION IN D
TTYBR1: MOVEI TT,F.MODE
MOVE F,@TTSAR(AR1)
MOVEI TT,F.CHAN ;C HAS OUTPUT FILE FOR ECHOING
.CALL RCPOS ;READ CURSOR POSITION INTO D
.VALUE
TLNE F,FBT<EC>
MOVE D,R ;MAYBE NEED ECHO AREA CURSOR
POPJ P,
TTYPSH: JSP T,FXCONS ;PUSH CHAR IN TT ON FRONT
PUSHJ P,CONS ; OF LIST OF BUFFERED CHARS
MOVEI B,(A)
JRST (R)
TTYATM: JUMPGE AR2A,(T) ;DECIDE WHETHER WE MAY HAVE
MOVE R,-1(FXP) ; TERMINATED A TOP LEVEL ATOM,
SKIPG -2(FXP) ; AND IF SO GO TO TTYB9 AND OUT
TLNE R,FBT<LN+FR> ;WE HAVE *NOT* TERMINATED IF:
JRST (T) ; NO USEFUL CHARS SEEN YET
; ; OPEN PARENS ARE HANGING
; ; TTY INPUT IS IN LINE MODE
; ; (STATUS TTYREAD <FILE>) = NIL
JRST TTYB9
TTYBCH: PUSHJ P,$DEVICE ;GOBBLE A CHARACTER
TRZ TT,%TX<TOP+SFL+SFT+MTA> ;FOLD TO 7 BITS
TRZN TT,%TX<CTL>
POPJ P,
CAIE TT,177
TRZ TT,140
MOVEI D,(TT) ;ATTEMPT TO FLUSH INTERRUPT CHARS
ROT TT,-1
ADDI TT,FB.BUF ;REALLY SHOULD BE MORE CLEVER
HRRZ AR1,VINFILE
HLRZ R,@TTSAR(AR1)
SKIPGE TT
HRRZ R,@TTSAR(AR1)
JUMPN R,TTYBCH
MOVEI TT,(D)
POPJ P,
TTYBLT: SKIPN AR1,C
POPJ P,
MOVEI A,(B) ;TYPE OUT ALL BUFFERED CHARS
PUSHJ P,NREVERSE ; ONTO THE ECHO OUTPUT FILE
MOVEI B,(A)
SKIPG -4(FXP) ;IF WE ENTERED WITH HANGING
JRST TTYBL1 ; PARENS, PRINT THEM
PUSH FXP,-4(FXP)
TTYBL4: MOVEI TT,"(
PUSHJ P,TYOFIL
SOSLE (FXP)
JRST TTYBL4
SUB FXP,R70+1
MOVEI TT,40
PUSHJ P,TYOFIL
TTYBL1: JUMPE B,TTYBL2 ;ECHO ALL CHARS TO ECHO TTY
HLRZ C,(B)
HRRZ TT,(C)
PUSHJ P,TYOFIL
HRRZ B,(B)
JRST TTYBL1
TTYBL2: PUSHJ P,NREVERSE
MOVEI B,(A) ;RESTORE BACKWARDS LIST OF CHARS
MOVE C,AR1 ;RESTORE C (NREVERSE CLOBBERED)
POPJ P,
;;; IFN QIO
RUBOUT: MOVEI D,QRUBOUT ;LSUBR (1 . 2)
CAMGE T,XC-2
JRST WNALOSE
JUMPE T,WNALOSE
CAME T,XC-2
SKIPA AR1,V%TYO
POP P,AR1
POP P,A
JSP F,TYOARG
MOVEI A,(TT)
PUSHJ P,TOFLOK
PUSHJ P,RUB1C1
JRST UNLKTRUE
SETZ A,
UNLKPOPJ
RUB1CH: HLRZ A,(B) ;DELETE CHAR FROM BUFFERED LIST
HRRZ B,(B)
JUMPE C,CPOPJ ;THAT'S IT IF NO ECHO FILE
PUSH P,A
HRRZ A,(A) ;GET CHARACTER IN A
MOVEI AR1,(C)
PUSHJ P,RUB1C1
JRST POPAJ
PUSHJ P,RSTCUR ;MUST RETYPE WHOLE STRING IN PLACE
PUSHJ P,TTYBLT
PUSHJ P,CNPL
JRST POPAJ
RSTCUR: HLLZ D,-3(FXP) ;RESTORE SAVED CURSOR POSITION
HRRI D,"V-10
PUSHJ P,RSTCU3
HRLZ D,-3(FXP)
HRRI D,"H-10
RSTCU3: ADD D,R70+10
JRST CNPCOD
;;; ROUTINE WHICH ATTEMPTS TO RUB OUT A CHARACTER ON A TTY.
;;; SKIPS ON *FAILURE* TO RUB IT OUT.
;;; OUTPUT TTY FILE ARRAY MUST BE IN AR1.
RUB1C1: MOVEI TT,F.MODE
MOVE F,@TTSAR(AR1)
TLNE F,FBT<SE> ;IF CAN'T SELECTIVELY ERASE
TLNN F,FBT<CP> ; AND MOVE CURSOR AROUND FREELY,
JRST TYOFA ; MERELY ECHO RUBBED-OUT CHAR
CAIN A,177 ;RUBOUT DOESN'T PRINT, HENCE NEEDN'T KILL
POPJ P,
MOVEI T,1
CAILE A,↑← ;CHARS FROM 40 TO 176 ARE ONE
JRST RUB1C3 ; POSITION WIDE, SO BACK UP AND ERASE
CAIN A,↑I ;TABS ARE VARIABLE - MUST RETYPE
JRST POPJ1
CAIN A,↑J ;LINE FEED IS DOWNWARD MOTION -
JRST CNPU ; ERASE BY MOVING UP
CAIN A,↑H ;BACKSPACE IS ERASED BY
JRST CNPF ; MOVING FORWARD
CAIE A,↑M ;FOR CR, DON'T KNOW LENGTH OF PREVIOUS LINE
CAIN A,↑← ;FOR ↑←, MAY OR MAY NOT HAVE BEEN DOUBLED
JRST POPJ1
CAIE A,33 ;ALTMODE IS ALWAYS 1 WIDE
TLNE TT,FBT<SA> ;OTHER CONTROLS ONE WIDE IF IN SAIL MODE
JRST RUB1C3
MOVEI T,2 ;OTHERWISE CONTROL CHARS ARE TWO WIDE
RUB1C3: MOVEI TT,F.CHAN
.CALL RCPOS
.VALUE
TLNE F,FBT<EC>
MOVE D,R
MOVEI R,(T)
CAILE T,(D)
PUSHJ P,CNPU
CAIE R,2
JRST CNPBL
JRST CNPBBL
;;; IFN QIO
;;; READLINE TAKES STANDARD FILE/EOF INPUT ARGUMENTS AND READS
;;; ONE LINE FROM A FILE. IT INVOKES PRE-SCANNING FOR TTY'S.
;;; THE RESULT IS RETURNED AS AN ATOMIC SYMBOL, EXCLUDING THE
;;; CARRIAGE RETURN WHICH TERMINATES THE LINE. LINE FEEDS
;;; ARE IGNORED (NECESSARY FOR SUCCESSIVE READLINE'S).
%READLINE: JSP D,INCALL
Q%READLINE
MOVEI A,Q%READLINE
HRLZM A,BFPRDP ;PERMIT TTY PRE-SCAN
MOVEI T,%RDLN5
PUSHJ FXP,MKNR6C ;PART OF MAKNAM
JRST PNGNK1 ;CREATE NON-INTERNED SYMBOL
%RDLN5: PUSH FXP,D
%RDLN6: PUSHJ P,@TYIMAN
CAIN TT,↑J ;IGNORE LINE FEEDS
JRST %RDLN6
POP FXP,D
CAIN TT,↑M ;CR TERMINATES
POPJ P,
MOVEI A,(TT)
JRST POPJ1
] ;END OF IFN QIO
SUBTTL HAIRY READER BIT DESCRIPTIONS
;OBJECT FLAGS - AS AN OBJECT ACCUMULATES, THE LH OF ACC T
; HAS BITS SET TO DESCRIBE THE STATE OF THE OBJECT
;BIT VALUE MEANING
;3.1 1 TOP LEVEL OBJECT
;3.2 2 FIRST OBJECT OF A LIST
;3.3 4 DOTTED PAIR OBJECT - SECOND HALF
;3.4 10 DELAYED DOT READ
;3.5 20 ALPHA ATOM (I.E., NON-NUMBER ATOM)
;3.6 40 NUMBER ATOM
;3.7 100 DECIMAL NUMBER
;3.8 200 FLOATING NUMBER
;3.9 400 NEGATIVE NUMBER
;4.1 1000 EXPONENT-MODIFIED NUMBER, E.G. ↑ OR E (OR SPLICING, IF MACRO)
;4.2 2000 LSH-ED NUMBER, I.E. ←
;4.3 4000 LIST-TYPE OBJECT
;4.4 10000 SIGNED NUMBER ATOM, E.G. +A
;4.5 20000 MACRO-PRODUCED OBJECT
;4.6 40000 BIGNUM BASE 10.
;4.7 100000 BIGNUM BASE IBASE
;CHARACTER FLAGS - THE RH OF AN ENTRY IN THE RCT TABLE
; GENERALLY HAS THE ASCII TRANSLATION FOR THE CHARACTER,
; EXCEPT MACRO-CHARACTERS, WHICH HOLD A FUNCTION TO EXECUTE
; THE LH HAS DESCRIPTOR BITS AS FOLLOWS:
;BIT VALUE MEANING
;3.1 1 ALPHABETIC, I.E. A,B,C,...,Z
;3.2 2 EXTENDED ALPHABETIC, E.G., !,",#,$, ETC. AND LOWERCASE
;3.3 4 DECIMAL DIGIT, I.E. 0,1,2,...,9
;3.4 10 + OR -
;3.5 20 ↑ OR ←
;3.6 40 SECOND CHOICE DENOTER FOR 3.4, 3.5, 4.1, AND 4.3
;3.7 100 PRINT SHOULD SLASHIFY IF NOT FIRST CHAR
;3.8 200 . <DECIMAL POINT> KIND OF DOT
;3.9 400 PRINT SHOULD SLASHIFY WHEN IN FIRST POSITION
;4.1 1000 THE RUBOUT CHARACTER, OR THE TTY FORCE FEED CHAR
;4.2 2000 THE READ "QUOTE" CHARACTER, I.E. /
;4.3 4000 MACRO CHARACTER, E.G. ', OR SPLICING MACRO
;4.4 10000 )
;4.5 20000 . <DOTTED-PAIR> KIND OF DOT
;4.6 40000 (
;4.7 100000 <SPACE> OR <TAB> OR <COMMA>
;4.8 200000 CHARACTER OBJECT
;4.9 400000 WORTHLESS CHARACTERS, AND ANY WITH BIT 3.8
; OR BITS 4.1-4.8 ON.
PGTOP RDR,[HIRSUTE READER, MAKNAM, ETC.]